home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / MCL Utilities / Sound Manager / kbd-player.lisp < prev    next >
Encoding:
Text File  |  1990-09-04  |  1.8 KB  |  73 lines  |  [TEXT/CCL ]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; Copyright 1987, 1988, 1989, 1990 by Ruben Kleiman for Apple Computer, Inc.
  3. ;;; Advanced Technology Group
  4. ;;;
  5.  
  6. ;;;
  7. ;;; KEYBOARD PLAYER:
  8. ;;;   Example of the use of the sound and event code
  9. ;;;   provided in "EVENTS" and "SOUND MANAGER" folders.
  10. ;;;   The number keys are bound to some note.  Evaluate this file and depress
  11. ;;;   some number keys to try this out.  Try command, shit, and
  12. ;;;   control keys to control sound durations.
  13.  
  14.  
  15. ;;; This requires the EVENT package.  
  16.  
  17. ;;; To set up some key bindings.
  18.  
  19.  
  20. (require :event)
  21.  
  22. (in-package :sound)
  23.  
  24. (provide :kbd-player)
  25.  
  26. (defun bind-nkeys ()
  27.   (event:add-eventhook '(play-number-keys) :fast))
  28.  
  29. (defun play-number-keys ()
  30.   (when (= 3 (%get-word *current-event* 0))  ; when key down
  31.     (let ((c (%get-signed-byte *current-event* 5))
  32.           (d (cond ((command-key-p) 500)
  33.                    ((shift-key-p) 1000)
  34.                    ((control-key-p) 2000)
  35.                    (t 40))))
  36.       (if (and (> c 47)
  37.                (< c 58))
  38.         (sound:do-pitch :d d :f (+ 50 (* (- c 47) 5)))))))
  39.  
  40. (defvar *pitch* nil)
  41. (defvar *vol* nil)
  42.  
  43.  
  44. ;;; could be defconstanted
  45. (defvar *vol-pix* (/ *screen-height* 255.0))
  46. (defvar *pitch-pix* (/ *screen-width* 127.0))
  47.  
  48. (defun play-mouse ()
  49.   (setq *pitch* (truncate (/ (point-h (%get-long ccl::*current-event* 10)) *pitch-pix*)))
  50.   (setq *vol* (truncate (/ (point-v (%get-long ccl::*current-event* 10)) *vol-pix*)))
  51.   (unless (or (> *pitch* 127)
  52.               (> *vol* 255)
  53.               (< *pitch* 0)
  54.               (< *vol* 0))
  55.     (sound::do-pitch :f *pitch* :a *vol*)))
  56.  
  57.  
  58.  
  59.  
  60. #| TO TRY IT OUT:
  61.  
  62. To bind number keys to sounds, evaluate:
  63.  
  64. (bind-nkeys)
  65.  
  66.  
  67. To cause mouse movement to vary sound, evaluate
  68.  
  69. (event::add-eventhook '(sound::play-mouse) :fast)
  70.  
  71. and move mouse around window.
  72.  
  73. |#